home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / fprotems.zip / PROWINDO.TLB < prev    next >
Text File  |  1993-01-04  |  16KB  |  691 lines
  1. <<Title Function library for PROWINDO.TEM>>
  2. <<uicode>>
  3. * PROWINDO.TLB
  4. * This library does windows.
  5. * Last modified 12/19/89
  6. ******************************* 
  7. function declare_all_windows **
  8. *******************************
  9. * Modified from a previously issued WallSoft function of the same name
  10. for all boxes where at("WINDOW", upper(box.descrip) )
  11.    declare_window(box)
  12. next
  13.  
  14. return
  15.  
  16. ************************** 
  17. function declare_window **
  18. **************************
  19. param b
  20. private n, ol, has_border
  21.  
  22. has_border = b.outline.type
  23. n = substr(box.name,1,10)
  24.  
  25. ? "DEFINE WINDOW {n} FROM {b.row}, {b.col} TO {b.bottom}, {b.right}"
  26. if has_border
  27.    if at("PANEL", upper(b.slot1))
  28.       ?? " PANEL ;"
  29.    else         
  30.       ol = b.outline.string
  31.       ?? " '{ol[2]}','{ol[6]}','{ol[8]}','{ol[4]}',"
  32.       ?? "'{ol[1]}','{ol[3]}','{ol[7]}','{ol[5]}' ;"
  33.    endif
  34.    if b.height >1 .and. strange_outline(b,0)
  35.       ? '{write_window_title(b)} ;'
  36.    endif
  37. else             ** it's a no-outline box
  38.    ?? " NONE ;"
  39. endif
  40. if ! empty(b.slot2)
  41.    ? '{b.slot2} ;'
  42. endif
  43.  
  44. ? "COLOR {b.contents.color},,{iif(has_border, b.outline.color, "")}"
  45. ?
  46.  
  47. return
  48.  
  49. ******************************
  50. function write_window_title **
  51. ******************************
  52. param b
  53.  
  54. private tline, msgstr, title, tokes, i
  55. tline = box_text(b,0,0)
  56. tokes = get_tokens("{tline}" ," [ ]  ─  ═  " )
  57. msgstr = ""
  58.  
  59. for i = 1 to len(tokes)
  60.   if isalpha({tokes[i]}) .or. at({tokes[i]}, "[ ]")
  61.      msgstr= msgstr + " " + tokes[i]
  62.   endif
  63. next
  64.  
  65. msgstr = alltrim(msgstr)
  66.  
  67. if len(msgstr)
  68.    title = 'TITLE "{msgstr}" '
  69. else
  70.   title = ""
  71. endif
  72.  
  73. return title
  74.  
  75. *****************************
  76. function write_window_text **
  77. *****************************
  78. param b
  79. private wr,wc,i
  80.  
  81. wr = 0
  82. wc = 0
  83.  
  84. for i = 1 to b.height - iif(b.outline.type, 2, 0)
  85.  
  86.    if b.outline.type
  87.       if len(alltrim({box_text(box,{wr+1},{wc+1},b.width -2)}))
  88.          ? '@ {wr},{wc} SAY ;
  89.          {digest_text(box_text(box,{wr+1},{wc+1},b.width -2))}'
  90.       endif
  91.    else
  92.       if len(alltrim({box_text(box,{wr},{wc},b.width)}))
  93.          ? '@ {wr},{wc} SAY ;
  94.          {digest_text(box_text(box,{wr},{wc},b.width ))}'
  95.       endif
  96.    endif
  97.    wr++
  98.    
  99. next
  100.  
  101. return
  102.  
  103. **********************
  104. function munch_slot **
  105. **********************
  106. * breaks a long Slot expression where the developer entered a semi-colon
  107. param sl
  108. private s_tokes,i
  109.  
  110. s_tokes = get_tokens("{sl}", " ; ")
  111.  
  112. for i = 1 to len(s_tokes)
  113.    ?? "{s_tokes[i]} "
  114.    if s_tokes[i] = ";"
  115.       ?
  116.    endif
  117. next
  118.  
  119. return
  120.  
  121. ***********************
  122. function digest_text **
  123. ***********************
  124. * a WallSoft genuine original
  125. param s
  126. private i,lquote,rquote
  127.  
  128. if at('"',s) 
  129.    if at("'",s)
  130.       if at("[",s) .or. at("]",s)  
  131.          s=strtran(s,'"','"+%'"%'+"')  
  132.          lquote='"'                    
  133.          rquote='"'
  134.       else                           
  135.          lquote='['
  136.          rquote=']'
  137.       endif
  138.    else                              
  139.       lquote="'"
  140.       rquote="'"
  141.    endif
  142. else                                
  143.    lquote='"'
  144.    rquote='"'
  145. endif
  146.  
  147. s=lquote+s+rquote
  148.  
  149. if ctrl_in_str(s)
  150.    if asc(s[2])<32           
  151.       s = "chr("+asc(s[2])+")+"+lquote+substr(s,3)
  152.    endif
  153.    
  154.    if asc(s[len(s)-1])<32    
  155.       s = substr(s,1,len(s)-2)+rquote+"+chr("+asc(s[len(s)-1])+")"
  156.    endif
  157.    
  158.    for i=3 to len(s)-2       
  159.       if asc(s[i])<32
  160.          ** break control char into '...+chr(n)+...' format
  161.          s=substr(s,1,i-1)+rquote+"+chr("+asc(s[i])+")+"+lquote+substr(s,i+1)
  162.          
  163.          i=i+7+(asc(s[i])>9) 
  164.       endif
  165.    endfor
  166.    
  167.    s=strtran(s,'+{lquote}{rquote}+','+')
  168. endif
  169.  
  170. return s
  171.  
  172. ***************************** 
  173. function get_var_in_window **
  174. *****************************
  175. * Modified from a previously issued WallSoft function of the same name
  176. param w,v
  177. private vr,vc, has_border
  178.  
  179. has_border = box.outline.type
  180.  
  181. if has_border
  182.    vc = v.col - w.col -1
  183.    vr = v.row - w.row -1
  184. else
  185.    vc = v.col - w.col
  186.    vr = v.row - w.row
  187. endif
  188.  
  189. ? "@ {vr}, {vc} GET {var_get_name(v)}"
  190. if v.picture
  191.    ??" PICTURE {v.picture}"
  192. endif
  193. if v.color
  194.    ?? " COLOR ,{v.color}"
  195. endif
  196. if v.range
  197.    ??" RANGE {v.range}"
  198. endif
  199. if .not. empty(v.valid)
  200.    ?? " VALID "                ** I've had second thoughts about this:
  201.                                ** If you take out this line, you have a
  202.                                ** choice of whether to use a VALID
  203.                                ** in a GET or not.  You have to supply
  204.                                ** the keyword VALID in the slot if you do
  205.                                ** take it out, but it's better that way.
  206.                                ** This way assumes you'll always have a
  207.                                ** VALID clause, which is bogus.  In fact
  208.                                ** if you don't have a VALID clause, the
  209.                                ** generated code, when run, will probably
  210.                                ** go huli if you leave this in.                               ** this in.
  211.                                ** Captain Afterthought strikes again.
  212.    munch_slot(v.valid)
  213. endif
  214.  
  215. return
  216.  
  217. *************************** 
  218. function box_wants_input **
  219. ***************************
  220. for all vars in box
  221.  
  222.    if var.input
  223.       return .T.
  224.    endif
  225. endfor
  226.  
  227. ************************
  228. function var_get_name **
  229. ************************
  230. * Genuine WallSoft original
  231. param v
  232. private name
  233.  
  234. if v.isfield .and. number_of_dbfs() > 1
  235.    name = iif( empty( (v.dbf).alias ), (v.dbf).name, ;
  236.    (v.dbf).alias )+ '->' + v.name
  237. else
  238.    if at("(",v.name) .or. at(")",v.name)
  239.       gen_msg("Warning: {v.name} is NOT a simple variable. "+;
  240.       "I'm about to generate @..GET code for it. "+;
  241.       "This code may be erroneous.")
  242.    endif
  243.    name=v.name
  244. endif
  245. return name
  246.  
  247. ************************************
  248. function get_field_dupe_in_window **
  249. ************************************
  250. * Modified from a WallSoft function of the same name
  251. param w,v
  252. private vr,vc
  253.  
  254. if box.outline.type  ** has a border, adjust box arithmetic 
  255.    vc = v.col - w.col -1
  256.    vr = v.row - w.row -1
  257. else          ** a no-border window, use UI2 box arithmetic
  258.    vc = v.col - w.col
  259.    vr = v.row - w.row
  260. endif
  261. ? "@ {vr}, {vc} GET {dupe_name(v)}"
  262. do case
  263. case v.picture
  264.    ??" PICTURE {v.picture}"
  265. case v.type = 'N'
  266.    ?? " PICTURE '"
  267.    if v.decimal >0
  268.       ?? "0."+replicate("0",v.decimal)
  269.    else
  270.       ?? replicate("0",v.length)
  271.    endif
  272.    ?? " '"
  273. endcase
  274.  
  275. if v.range
  276.    ??" RANGE {v.range}"
  277. endif
  278. if .not. empty(v.valid)
  279.    ?? " VALID "
  280.    munch_slot(v.valid)
  281. endif
  282.  
  283. return
  284.  
  285. ***************************** 
  286. function say_var_in_window **
  287. *****************************
  288. * Modified from a WallSoft function of the same name
  289. param w,v
  290. private vr,vc, has_border
  291.  
  292. has_border = box.outline.type
  293.  
  294. if has_border
  295.    vc = v.col - w.col -1
  296.    vr = v.row - w.row -1
  297. else
  298.    vc = v.col - w.col
  299.    vr = v.row - w.row
  300. endif
  301. ? "@ {vr}, {vc} SAY {var_say_name(v)}"
  302. if v.picture
  303.    ??" PICTURE {v.picture}"
  304. endif
  305. return
  306.  
  307. *************************
  308. function var_say_name **
  309. ************************
  310. * A genuine WallSoft original
  311. param v
  312. private name, areaptr
  313.  
  314. if v.isfield .and. number_of_dbfs() > 1
  315.    if .not. empty(v.display_formula)
  316.       name = v.display_formula
  317.       if .not. at(lower(v.name),lower(v.display_formula))
  318.          gen_msg("Warning: can't find variable name '{v.name}' within "+;
  319.          "display_formula ({v.display_formula}). The display_formula "+;
  320.          "will be used in an @..SAY statement. Code may be erroneous.")
  321.       else
  322.          areaptr = iif( empty((v.dbf).alias), (v.dbf).name, (v.dbf).alias)+;
  323.          '->'
  324.          name = strtran( name, v.name, areaptr+v.name )
  325.       endif
  326.    else
  327.       name = iif( empty((v.dbf).alias), (v.dbf).name, (v.dbf).alias )+;
  328.       '->' +;
  329.       v.name
  330.    endif
  331. else
  332.    if .not. empty(v.display_formula)
  333.       name=v.display_formula
  334.    else
  335.       name=v.name
  336.    endif
  337. endif
  338.  
  339. return name
  340.  
  341. ************************
  342. function var_init_val **
  343. ************************
  344. * A genuine WallSoft Original
  345. param v
  346.  
  347. do case
  348. case v.init_val         
  349.    return v.init_val
  350.    
  351. case v.type = 'C'       
  352.    return "SPACE({v.length})"
  353.    
  354. case v.type = 'N'       
  355.    if v.decimal >0
  356.       return "0."+replicate("0", v.decimal)
  357.    else
  358.       return replicate("0",v.length)
  359.    endif
  360.    
  361. case v.type = 'L'       
  362.    return ".F."
  363.    
  364. case v.type = 'D'       
  365.    return "CTOD('  /  /  ')"
  366. endcase
  367.  
  368. return
  369.  
  370. *********************
  371. function dupe_name **
  372. *********************
  373. * A genuine WallSoft original
  374. param f, pflet
  375. private fname
  376.  
  377. if pcount() < 2 .or. !pflet
  378.    fname = "m" + substr(f.name,1,9)
  379. else
  380.    if at("->", pflet)
  381.       fname = pflet + f.name
  382.    else
  383.       fname = pflet + substr(f.name,1, 10-len(pflet)) 
  384.    endif
  385. endif
  386. return fname
  387.  
  388. ******************************* 
  389. function declare_field_dupes **
  390. *******************************
  391. * A genuine WallSoft original
  392. param pflet
  393.  
  394. if pcount() = 0
  395.    pflet = "m"
  396. endif
  397. declare_prefix_in_box(pflet)
  398. return
  399.  
  400. *********************************
  401. function declare_prefix_in_box **
  402. *********************************
  403. * A genuine WallSoft original
  404. param pflet, b
  405. private stmt                     
  406. private firstvar                 
  407. private stmtlen                  
  408. private memname,abox             
  409.  
  410. abox = pcount() > 1              
  411. firstvar = .t.                   
  412. stmtlen = 0
  413. stmt = ""
  414.  
  415. for all fields                   
  416.    loop when abox .and. field.owner <> b  
  417.    memname = dupe_name(field, pflet)
  418.    
  419.    if stmtlen >= 65                  
  420.       ? stmt
  421.       firstvar = .t.
  422.    endif
  423.    if firstvar                       
  424.       stmt = "PRIVATE " + memname    
  425.       firstvar = .f.                 
  426.       stmtlen = len(stmt)
  427.    else                              
  428.       stmt = stmt + ", " + memname
  429.       stmtlen = stmtlen + 2 + len(memname) 
  430.    endif
  431. endfor
  432.  
  433. ? stmt 
  434. return
  435.  
  436. *************************
  437. function init_all_dbfs **
  438. *************************
  439. * A genuine WallSoft original
  440. param dbfpathvar, indexpathvar, check
  441. private i, primary_specified, nargs
  442.  
  443. nargs = pcount()
  444. check_areas()
  445. path_setup(nargs)
  446.  
  447. * Note that 'for all dbfs' only sees DBFs used in form
  448. for all dbfs
  449.    selectNuse(dbf,dbfpathvar,indexpathvar,check)
  450. endfor
  451.  
  452. * Set relation code
  453. ?
  454. for all dbfs
  455.    set_rels(dbf)
  456. endfor
  457.  
  458. * if more than one DBF is selected
  459. if number_of_dbfs() >1
  460.    primary_specified = .f.
  461.    for all dbfs where dbf.primary
  462.       select_alias(dbf)
  463.       primary_specified = .t.
  464.    next
  465.    if .not. primary_specified
  466.       ?'SELECT 1'
  467.    endif
  468. endif
  469. return
  470.  
  471. **********************
  472. function path_setup **
  473. **********************
  474. * A genuine WallSoft original
  475. param nargs
  476.  
  477. switch nargs
  478. case 0
  479.    dbfpathvar = ""
  480.    indexpathvar = ""
  481.    check = .f.
  482. case 1
  483.    dbfpathvar = "&{dbfpathvar}."
  484.    indexpathvar = ""
  485.    check = .f.
  486. case 2
  487.    dbfpathvar = empty(dbfpathvar) ? "" : "&{dbfpathvar}."
  488.    indexpathvar = "&{indexpathvar}."
  489.    check = .f.
  490. case 3
  491.    dbfpathvar = empty(dbfpathvar) ? "" : "&{dbfpathvar}."
  492.    indexpathvar = empty(indexpathvar) ? "" : "&{indexpathvar}."
  493. endsw
  494.  
  495. return
  496.  
  497. **********************
  498. function selectNuse **
  499. **********************
  500. * A genuine WallSoft original
  501. param thisdbf, dbfpath, indexpath, check
  502. private i, dname
  503.  
  504. ? "* Open database {thisdbf.name}"
  505. if .not. empty(thisdbf.alias)
  506.    ?? " (alias {thisdbf.alias})"
  507. endif
  508.  
  509. if len(thisdbf.indexes) > 0
  510.    ? "*"
  511.    ? "* Indexes used:"
  512.    for i = 1 to len(thisdbf.indexes)
  513.       ? "* {i}: {thisdbf.indexes[i].name} ('{thisdbf.indexes[i].expr}')"
  514.    next
  515. endif
  516.  
  517. ? "*"
  518. if thisdbf.area
  519.    ?"SELECT {thisdbf.area}"
  520. else
  521.    ?"SELECT 1"
  522. endif
  523.  
  524. ?"USE {dbfpath}{striptag(thisdbf.name)}"
  525.  
  526. if thisdbf.alias
  527.    ??" ALIAS ", thisdbf.alias
  528. else
  529.    dname = upper(striptag(stripdir(thisdbf.name)))
  530.    for all dbfs
  531.       n = len(dbf.relations)
  532.       for i = 1 to n
  533.          exit when upper(dbf.relations[i].name) = dname
  534.       endfor
  535.       exit when i <= n
  536.    endfor
  537.    if i <= n
  538.       ??" ALIAS {dname}"
  539.    endif
  540. endif
  541.  
  542. if check .and. len(thisdbf.indexes) > 0
  543.    ? "* first, check the existence of needed indexes"
  544.    for i = 1 to len(thisdbf.indexes)
  545.       ?'IF .not. file("{indexpath}{thisdbf.index[i].name}{ndxtag}")'
  546.       ?"  INDEX ON {thisdbf.index[i].expr} TO "+;
  547.       "{indexpath}{thisdbf.index[i].name}{ndxtag}"
  548.       ?"ENDIF"
  549.    next
  550.    ?
  551.    ? "* now SET INDEX"
  552.    ?
  553.    for i = 1 to len(thisdbf.indexes)
  554.       ?? "{iif(i = 1, "SET INDEX TO ", ",")} {indexpath}{thisdbf.index[i].name}"
  555.    next
  556. else
  557.    for i = 1 to len(thisdbf.indexes)
  558.       ?? "{iif(i = 1, " INDEX ", ",")} {indexpath}{thisdbf.index[i].name}"
  559.    next
  560. endif
  561.  
  562. return
  563.  
  564. ********************
  565. function set_rels **
  566. ********************
  567. * A genuine WallSoft original
  568. param thisdbf
  569. private i, reldbf, thisname, ndicdbfs, ndbfs
  570.  
  571. if len(thisdbf.rel) = 0
  572.    return
  573. endif
  574.  
  575. ?"* relation code for ", thisdbf.name
  576. select_alias(thisdbf) 
  577.  
  578. ndicdbfs = len(dicdbf_array)
  579. ndbfs = len(dbf_array)
  580.  
  581. for i = 1 to len(thisdbf.rel)
  582.    
  583.    ?  "SET RELATION "
  584.    ?? "TO "
  585.    ?? thisdbf.rel[i].expr
  586.    ?? " INTO "
  587.    
  588.    reldbf = 0
  589.    thisname = thisdbf.rel[i].name
  590.    for j = 1 to ndbfs 
  591.       if dbf_array[j].name = thisname
  592.          reldbf = dbf_array[j]
  593.          exit
  594.       endif
  595.    next
  596.    
  597.    if .not.reldbf     
  598.       for j = 1 to ndicdbfs
  599.          if dicdbf_array[j].name = thisname
  600.             reldbf = dicdbf_array[j]
  601.             exit
  602.          endif
  603.       next
  604.    endif
  605.    
  606.    if .not.reldbf
  607.       gen_error("{thisdbf.name} related file: {thisname} not in dictionary")
  608.    endif
  609.    
  610.    ?? iif(.not. empty(reldbf.alias), reldbf.alias, reldbf.name)
  611.    if i > 1
  612.       ??" ADDITIVE"
  613.    endif
  614. next
  615.  
  616. return
  617.  
  618. ***********************
  619. function check_areas **
  620. ***********************
  621. * A genuine WallSoft original
  622. private areas
  623.  
  624. areas = array('DBF',10)
  625. for all dbfs
  626.    if dbf.area > 0 .and. dbf.area <= 10
  627.       if areas[dbf.area]
  628.          gen_error("DBF {areas[dbf.area].name} ;
  629.         has same area number as {dbf.name}")
  630.       else
  631.          areas[dbf.area] = dbf
  632.       endif
  633.    endif
  634. endfor
  635. return
  636.  
  637. ************************
  638. function select_alias **
  639. ************************
  640. * A genuine WallSoft original
  641. param d
  642.  
  643. ? "SELECT {alias(d)}"
  644. return
  645.  
  646. *****************
  647. function alias **
  648. *****************
  649. * A genuine WallSoft original
  650. param d
  651. return (empty(d.alias) ? d.name : d.alias)
  652.  
  653. ********************
  654. function init_var **
  655. ********************
  656. * A genuine WallSoft original
  657. param v
  658. private iv,isfld,vn
  659.  
  660. if .not. v.input .and. empty(v.init_val)    
  661.    return                                   
  662. endif
  663.                                        
  664. iv = var_init_val(v)
  665. isfld = (type(v) = "FIELD" || (type(v) = "VAR" && v.isfield))
  666. vn = build_var_name(v)
  667.  
  668. if isfld
  669.    ? "REPLACE {vn} WITH {iv}"
  670. else
  671.    ? "{vn} = {iv}"
  672. endif
  673. return
  674.  
  675.  
  676. ************************** 
  677. function build_var_name **
  678. **************************
  679. * A genuine WallSoft original
  680. param v
  681. private vn
  682.  
  683. if number_of_dbfs() > 1 .and. v.isfield
  684.    vn = (empty(v.dbf.alias) ? v.dbf.name : v.dbf.alias) + "->" + v.name
  685. else
  686.    vn = v.name
  687. endif
  688. return vn
  689.  
  690. <<enduicode>>
  691.